perm filename TMP[GEM,BGB] blob sn#088726 filedate 1974-03-03 generic text, type T, neo UTF8
SUBR(SLICE0,BDYSET)	;SLICE A SET OF BODIES AT ZCUT LEVEL.
;--------------------------------------------------------------------
;INITIALIZATION.
	DZM ELIST2	;LIST OF LISTS OF SHORT EDGES.
	DZM FSET1	;LIST OF PZ SLICE FACES.

;LOOP FOR CUTTING BODIES OF THE BODY SET.
	LAC 1,BDYSET↔SON 1,1↔DAC 1,B0↔DAC 1,B	;INIT THE LOOP.
L1:	CALL(VMARK,B)				;MARK VERTICES PZ & NZ.
	SKIPN PZCNT↔GO .+3			;PIECE FULLY BELOW.
	SKIPE NZCNT↔GO[CALL(FECUT,B)↔GO .+1]	;CUT FACES AND EDGES.
	LAC 1,B↔BRO 2,1↔DAC 2,B			;ADVANCE ALONG BODY RING.
	SKIPN PZCNT↔GO[CALL(KLBFEV,1)↔GO .+1]	;KILL PIECE FULLY BELOW.
	LAC 1,B↔CAME 1,B0↔GO L1			;...AND FALL THRU.
;--------------------------------------------------------------------
;SLICE THE SOLID  -  MAPCAR UNGLUE DOWN THE ALT2 EDGE LIST 2.
L2:	SKIPN 2,ELIST2↔GO L5
	ALT2 1,2↔DAC 1,ELIST2
	DAC 2,ELIST1

;KILL THE TIES THAT BIND  -  MAPCAR KLFE DOWN THE ALT EDGE LIST 1.
L3:	SKIPN 2,ELIST1↔GO L4
	ALT 1,2↔DAC 1,ELIST1
	PFACE 0,2↔DAC 0,FACE1
	SETQ(FACE2,{KLFE,2})↔GO L3

;PLACE THE NEW FACES OF THE SLICE INTO A RING.
L4:	LAC 1,FACE1↔LAC 2,FACE2↔ALT. 1,2↔ALT. 2,1	;TWO NEW FACES.
	TEST 1,PZ↔EXCH 1,2↔SKIPE 4,FSET1↔GO .+5		;THE PZ FACE.
	DIP 1,8(1)↔DAP 1,8(1)↔DAC 1,FSET1↔GO L2		;SELF RING.
	CAR 3,8(4)↔DAP 1,8(3)↔DIP 3,8(1)		;RING IN.
	DAP 4,8(1)↔DIP 1,8(4)↔GO L2
;--------------------------------------------------------------------
;UPDATE SET OF POSITIVE BODIES IN BSET1.
L5:	LAC 1,FSET1↔DAC 1,FACE1
L6:	LAC 1,FACE1↔CDR 1,8(1)↔DAC 1,FACE1	;ADVANCE CUT-FACE RING.
	PED 1,1↔CCW 1,1↔CALL(BATT,1,BSET1)
	LAC 1,FACE1↔CAME 1,FSET1↔GO L6↔POP1J

DECLARE{EDGE,FACE1,FACE2,B,B0}
ENDR SLICE0;1/12/74(BGB)---------------------------------------------
SUBN(VMARK,BODY)	    ;MARK THE VERTICES OF A BODY AS PZ OR NZ.
;--------------------------------------------------------------------
	ACCUMULATORS{V,PDEL,NDEL,E,E0}

;CLEAR THE NZ AND PZ BITS OF ALL THE EDGES AND VERTICES.
	DZM PZCNT↔DZM NZCNT
	LACI PZ+NZ↔LAC 1,BODY
	ANDCAM(1)↔PVT 1,1↔CAME 1,BODY↔GO .-3
	ANDCAM(1)↔PED 1,1↔CAME 1,BODY↔GO .-3

;POSITIVE AND NEGATIVE EPSILON.
	LAC PDEL,ZCUT↔FADR PDEL,[0.01]
	LAC NDEL,ZCUT↔FSBR NDEL,[0.01]

;FORCE THE VERTICES TO BE ABOVE OR BELOW THE SLICE PLANE.
	LAC V,BODY
L1:	PVT V,V↔CAMN V,BODY↔POP1J

L2:	LAC ZWC(V)
	CAML PDEL↔GO[MARK V,PZ↔AOS PZCNT↔GO L3]
	CAMG NDEL↔GO[MARK V,NZ↔AOS NZCNT↔GO L3]
	FSBR ZCUT
	SKIPL ↔DAC PDEL,ZWC(V)
	SKIPGE↔DAC NDEL,ZWC(V)↔GO L2

;MARK THE EDGES OF THIS VERTEX AS PZ OR NZ.
L3:	PED E,V↔LAC E0,E
L4:	PVT 1,E↔CAME 1,V↔GO .+3↔PCW 1,E↔GO L5	   ;AC1 ← ECCW(E,V).
	NVT 1,E↔CAME 1,V↔GO L1 ↔NCW 1,E
L5:	IORM 0,(E)↔LAC E,1			;AC0 CONTAINS THE BIT.
	CAME E,E0↔GO L4↔GO L1

ENDR VMARK;1/11/74(BGB)---------------------------------------------

	DECLARE{PZCNT,NZCNT}
SUBN(FECUT,BODY)	    ;FACE EDGE CUTTING.
;--------------------------------------------------------------------
	ACCUMULATORS{V2,V1,DX,DY,DZ}

;SCAN THE EDGES OF THE BODY FOR ZCUT CROSSINGS.
	LAC 1,BODY↔DAC 1,EDGE#
L0:	LAC 1,EDGE↔NED 1,1↔DAC 1,EDGE	;ADVANCE ALONG EDGE RING.
	CAMN 1,BODY↔POP1J		;TEST FOR END OF EDGE RING.
	TEST 1,PZ↔GO L0			;TEST FOR EDGE CROSSING.
	TEST 1,NZ↔GO L0

;INITIALIZATION FOR FACE-EDGE CUT FOR A SINGLE SLICE FACE.
	DOM FLAG			;FIRST TIME THRU FLAG -1.
	DZM ELIST1			;LIST OF VERY SHORT EDGES.
	LAC 1,EDGE
	DAC 1,E↔NVT 2,1↔TEST 2,PZ
	GO[CALL(INVERT,E)↔GO .+1]	;FORCE NVT(E) INTO PZ HALF-SPACE.
	LAC 1,E↔NFACE 1,1
	DAC 1,F0↔DAC 1,F		;FIRST FACE.

;SPLIT EDGE - SO THAT PVT(E) IS IN NZ HALF SPACE.
L1:	LAC 1,E↔MARKZ 1,PZ+NZ
	NVT V1,1↔PVT V2,1↔PUSH P,V2↔PUSH P,V1	;SAVE OLDE VERTICES.
	TEST V1,PZ↔GO[CALL(INVERT,E)↔GO .+1]	;FORCE NVT(E) INTO PZZ.
	SETQ(U2,{ESPLIT,E})↔MARK 1,PZ		;PZ HALFSPACE.
	PED 1,1
	LAC 2,ELIST1↔ALT. 2,1↔DAC 1,ELIST1	;CONS EDGE INTO ELIST1.
	SETQ(UU2,{ESPLIT,ELIST1})↔MARK 1,NZ	;NZ HALFSPACE.


;COMPUTE LOCUS WHERE E INTERSECTS THE SLICE PLANE.
	POP P,V1↔POP P,V2			;RESTORE OLDE VERTICES.
	LAC DX,XWC(V2)↔FSBR DX,XWC(V1)
	LAC DY,YWC(V2)↔FSBR DY,YWC(V1)
	LAC DZ,ZWC(V2)↔FSBR DZ,ZWC(V1)
	LAC ZCUT↔FSBR ZWC(V1)↔FDVR DZ↔LAC 2,U2		;COEFFICIENT K.
	FMPR DX,0↔FADR DX,XWC(V1)↔DAC DX,XWC(1)↔DAC DX,XWC(2)
	FMPR DY,0↔FADR DY,YWC(V1)↔DAC DY,YWC(1)↔DAC DY,YWC(2)
	FMPR DZ,0↔FADR DZ,ZWC(V1)↔DAC DZ,ZWC(1)↔DAC DZ,ZWC(2)

;FIRST TIME ONLY.
	AOSG FLAG↔GO[
	LAC U2↔DAC U0
	LAC UU2↔DAC UU0↔GO L2]

;DOUBLE FACE SPLIT.
	CALL(MKFE,U2,F,U1)
	NFACE 1,1
	CALL(MKFE,UU2,1,UU1)

;ADVANCE INTO THE NEXT FACE & FIND NEXT CROSSING EDGE.
L2:	LAC U2↔DAC U1↔LAC UU2↔DAC UU1
	SETQ(F,{OTHER,E,F})
	CAMN 1,F0↔GO L4
L3:	SETQ(E,{ECCW,E,F})
	TEST 1,NZ↔GO L3
	GO L1

;DOUBLE CUT LAST (FIRST) FACE.
L4:	CALL(MKFE,U0,F,U1)
	NFACE 1,1
	CALL(MKFE,UU0,1,UU1)

;CONS ELIST1 INTO ELIST
	LAC 1,ELIST1↔LAC 2,ELIST2
	ALT2. 2,1↔DAC 1,ELIST2↔GO L0

DECLARE{F,E,U0,U1,U2,F0,FLAG,UU0,UU1,UU2}
ENDR FECUT;1/11/74(BGB)---------------------------------------------